#lang racket

(require srfi/41) ; Stream library
(require test-engine/racket-tests)
(require racket/pretty)

(require "derivative-parsers.rkt")


;;;; Helper
(define (maybe-str->val val)
  (cond
    [(symbol? val) val]
    [(string? val) (string->symbol val)]
    [(number? val) val]
    [else (error 'lst->strs "value of unknown type: ~e" val)]))

;;;; C grammar

(define (mk-tag? tag-name)
  (lambda (token)
    (eq? (car token) tag-name)))

(define (mk-value? predicate)
  (lambda (token)
    (predicate (cadr token))))

(define NAME      (lang (@--> (token (mk-tag? 'ID) 'NAME)
                              (λ (_ id) (string->symbol id)))))
(define NUMBER    (lang (@--> (token (and/c (mk-tag? 'LIT) (mk-value? number?)) 'NUMBER)
                              (λ (_ num) num))))
(define STRING    (lang (@--> (token (and/c (mk-tag? 'LIT) (mk-value? string?)) 'STRING)
                              (λ (_ str) str))))
(define TYPE      (lang (@--> (token (mk-tag? 'TYPE) 'TYPE)
                              (λ (_ type) (string->symbol type)))))

(define NEWLINE   (token (mk-tag? 'NEWLINE) 'NEWLINE))
(define ENDMARKER (token (mk-tag? 'ENDMARKER) 'ENDMARKER))
(define INDENT    (token (mk-tag? 'INDENT) 'INDENT))
(define DEDENT    (token (mk-tag? 'DEDENT) 'DEDENT))



(define (C-literal->language x)
  (match x
    [(or "?" ":" "[" "]" "+" "-" "(" ")" ";" "{" "}"
         "<" ">" "==" "<=" ">=" "!=" "=" ",")
     (lang (>--> (token (and/c (mk-tag? 'PUNCT) (mk-value? (λ (v) (equal? v x)))) x)
                 [`(PUNCT ,k) k]))]
    
    [(or "new" "goto" "if" "len")
     (lang (>--> (token (and/c (mk-tag? 'KEYWORD) (mk-value?
                                                   (λ (v) (equal?
                                                           (maybe-str->val x)
                                                           (maybe-str->val v)))))
                        x)
                 [`(KEYWORD ,k) k]))]
    
    [else
     (printf "unknown literal: ~s~n" x)
     (error "unknown literal")]))

(set-literal->language! C-literal->language)

(define C-lang
  (grammar-from-file file_input "C-ast.grm.sx"))

(define args (current-command-line-arguments))

(define (C-parse-file filename)
  (C-parse-port (open-input-file filename)))

(define (C-parse-port port)
  (define lines (read-all port))
  (define forest (parse C-lang (list->stream lines) #:compact compact))
  (cond
    [(= (set-size forest) 1)
     (pretty-write (set-choose forest))
     (newline)]
    
    [(= (set-size forest) 0)
     (pretty-write #f) 
     (newline)]
    
    [else
     (printf "; ambiguous grammar:~s~n" (write forest))]))

(match args
  [(vector filename)
   ; =>
   (C-parse-file filename)
   (exit)]
  
  [else
   ; =>
   (C-parse-port (current-input-port))])
